home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 2 / CU Amiga Magazine's Super CD-ROM 02 (1996)(EMAP Images)(GB)[!][issue 1996-04].iso / magazine / amiga_e / yax / hanoi.yax next >
Lisp/Scheme  |  1992-09-02  |  3KB  |  97 lines
  1. /* Hanoi.yax freeware v1.0 @ Ben Schaeffer1993 */
  2.  
  3. /*button function needs size => 3*/ (defun button (upleftx uplefty size)
  4.    (box upleftx uplefty (+ upleftx (*2 size)) (+ uplefty size) 2)
  5.    (box (+2 upleftx) (+1 uplefty) (+ upleftx (*2 size)) (+ uplefty size) 1)
  6.    (set size (- size 1))
  7.    (box (+2 upleftx) (+1 uplefty) (+ upleftx (*2 size)) (+ uplefty size) 0) )
  8.  
  9. (defun gadget (q)
  10.    (set move 5)
  11.    (while (eq move 5)
  12.       (while (eq 0 (mouse)))
  13.       (set x (mousex))
  14.       (set y (mousey))
  15.       (if (smaller y 9) (if (smaller x 14)(set move 0))
  16.          (if (and (smaller y 72)(smaller x 64)(greater y 22)(greater x 32))
  17.             (if (smaller y 40)(set move 1)
  18.                (if (greater y 54) (set move 3) (set move 2))
  19.             )
  20.          )
  21.       )
  22.    )
  23.    (while (eq (mouse) 1)) )
  24.  
  25. (window 120 10 300 132 'O      Hanoi Tower Puzzle  ')
  26.  
  27. (set towerheight -1)
  28. (write 'Stack the numbers on box 3') 
  29. (write 'by putting little numbers') 
  30. (write 'onto bigger numbers.') 
  31. (write) 
  32. (write 'Use the mouse on boxes!') 
  33. (write) 
  34. (write 'Type in you tower height 3-9') 
  35. (while (or (greater towerheight 9)(smaller towerheight 3)) (set towerheight (readint)) )
  36. (cls)
  37. (set tower 0)
  38. (for count towerheight 1
  39.    (set tower (+ count (* tower 10))) )
  40.    (set again -1) (array row 3) (set (row 0) -1) (until (eq 0 again)
  41.    (set turn 0)
  42.    (set (row 1) tower)
  43.    (set (row 2) 0)
  44.    (set (row 3) 0)
  45.    (cls)
  46.    (button 33 23 15)(locate 3 6)(write 1)
  47.    (button 33 39 15)(locate 5 6)(write 2)
  48.    (button 33 55 15)(locate 7 6)(write 3)
  49.  
  50.    (while (and (uneq 0 again)(uneq tower (row 3)))
  51.       (set turn (+ 1 turn))
  52.       (for count 1 3
  53.          (locate (+ 1 (* 2 count)) 9)
  54.          (if(row count)(write (row count) '          ')(write '  '))
  55.       )
  56.       (locate 1 1)
  57.       (while (uneq (mouse) 1))
  58.       (write '  From          ')
  59.       (locate 1 1)
  60.       (gadget move)
  61.       (set moveone move)
  62.       (while (eq 0 (row moveone))(gadget 1)(set moveone move))
  63.       (if (eq moveone 0) (set again 0)
  64.          (do
  65.             (locate 1 8) (write move'  To   ') (locate 1 14)
  66.             (gadget 1)
  67.             (set movetwo move)
  68.             (if (eq movetwo 0) (set again 0)
  69.                (do
  70.                   (set tempone (- (row moveone) (* (/ (row moveone) 10) 10)))
  71.                   (set temptwo (- (row movetwo) (* (/ (row movetwo) 10) 10)))
  72.                   (if (or (eq moveone movetwo)
  73.                         (and temptwo (greater tempone temptwo)))
  74.                      (do
  75.                         (locate 1 1)
  76.                         (write ' Invalid Move.    ')
  77.                         (locate 1 1)
  78.                      )
  79.                      (do
  80.                         (write move) (locate 1 1)
  81.                         (set (row movetwo) (+ tempone (* (row movetwo) 10)))
  82.                         (set (row moveone) (/ (row moveone) 10))
  83.                      )
  84.                   )
  85.                )
  86.             )
  87.          )
  88.       )
  89.    )
  90.    (cls)
  91.    (if (eq tower (row 3))
  92.       (write 'You got it! It took you 'turn' turns')
  93.    )
  94.    (write 'Would you like to play again?')
  95.    (write 'Type 0 for no, 1 for yes:')
  96.    (set again (readint)) )
  97.